Libris Britannia 4/science library(b).zip/science library(b)/TECHNICA/AUTOCAD/H108.ZIP/MM10.ZIP/MMS.LSP

Lisp/Scheme | 1991-08-01 | 11KB | 281 lines

;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;           AutoCAD tm  Macro Maker  V 1.00
;; Author: SCOTT HARES   1108 Kelez Dr.  San Jose CA, 95120
;;                Voice: 408-927-6337
;;            CompuServe tm  ID 73730,1643
;;           Copyright (C) 1991 Scott Hares
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; To manage macros a global list called key_list is used. Key_list stores
;; any number of dotted pairs which define a macro. These dotted pairs
;; (referred to as a key list) hold the keys ascii code on the left, and the
;; keys macro on the right. The structure of this arrangement can be described
;; as a list (key_list) of key lists (dotted pairs). A typical example of this
;; might look like: (("0;30" . "alt-a")("0;48" . "alt-b")("0;46" . "alt-c"))
;; Three macros are defined at this point, the will echo to the screen "alt-a"
;; if alt-a is hit (same for alt-b and alt-c).
;;

(defun c:mm( / does_exist ESC RETURN BACKSP table string *error* key
               table old_rec rec_key flag)
(textscr)

;;******* error handler ************
(defun *error*(msg)
(mmlll)
(terpri)
(princ (strcat "ERROR: " msg))
(princ)
)

;;**************************************
;; check to see if the key pressed has already been assigned a macro. This
;; is done so that a key list will not be added into key_list more than once.
;; If this code finds that a key has already been assigned a macro (and a key
;; list for it) in key_list then the flag returned will tell MM to substitute
;; the new key list for the old key list rather than adding key list to
;; key_list
;;
;; Macros have been suspended at this point so keys codes will reflect there
;; correct ascii value instead of reflecting the keys macro.
;;
;; accepts the key code entered by user as a string
;; returns flag integer
(defun does_exist( exist / x flag )
(setq flag 0)                   ;; set flag to zero
(foreach x key_list             ;; check each key assignment list in key_list
    (if (= exist (car x))       ;; to see if the key has already been defined
       (progn
          (setq flag 1)         ;; turn on flag if key code is found in key_list
          (setq old_rec x)      ;; and save old key list for substitution later
       );;progn                 ;; on in program
    );;if
);;foreach
(eval  flag)                    ;; return either 0 for new macro assignment or
);;defun                        ;; 1 for macro redefinition

;;******* MAIN *******

;;initialize variables and constants
(setq key       nil
      string    "\e["
      table     ""
      RETURN    13
      BACKSP    8
      ESC       27
)

;;un-init current macros so that macros will not run during definition
(mmu)

;;get key to record to and display prompt for macro data. Assign the key
;;value to key. Macro data is collect later
(princ               "Terminate macro record with ESCAPE key")(terpri)
(princ               "Press the key you wish to assign macro to: ")
(setq rec_key (get_key)) (terpri)
(princ "Enter the keystrokes to be recorded to macro: ") (terpri)


;;if the user hit an extended key like ALT-1, then some formatting must be
;;done so the ansi driver knows what key combo was pressed.
   (if (> rec_key 125)
      (setq rec_key (strcat "0;" (itoa (- rec_key 128)) ))
      (setq rec_key (itoa rec_key))
   );;if

;;check if key has been defined already, and set flag for list substitute
;;rather than list addition
(setq flag (does_exist rec_key))

;;required because while statement does not check to see
;;if key equals ESC until after key is processed
(setq key (get_key))

;;collect key strokes to be defined to a key until ESCape key is hit
(while (/= key ESC)
   (cond
     ((= key RETURN)                    ;;return key presents problems
        (setq table (strcat table " ")) ;;these two lines substitute a space
        (princ " ")                     ;;for carriage return, and will behave
     );;cond                            ;;the same as a carriage return
     ((and (= key BACKSP) (> (strlen table) 0))            ;;get rid of
        (prompt "\e[D\e[K")                                ;; unwanted
        (setq table (substr table 1 (1- (strlen table)) )) ;;character
     );;cond
     (T
        (setq table (strcat table (chr key)))  ;;if key was not ESCape, return
        (princ (chr key))                      ;;or backspace, then add
     );;cond                                   ;;character to string
   );;cond
   (setq key (get_key))                        ;;get next character
);;while

(terpri)

;;build key_list with current key list. three options below are to start
;;key_list if it does not exist, add a new key list to key_list, or substitute
;;new macro for old macro if the key has already been assigned a macro
(COND
  ;;adding first definition, key_list does not yet exist
  ((and (= flag 0) (not key_list))
      (setq key_list (list (cons rec_key table))) );;cond

  ;;adding a new definition and key_list already exists
  ((and (= flag 0) key_list)
      (setq key_list (append key_list (list (cons rec_key table )))) );;cond

  ;;redefining a key which has already been defined in key_list
  ((and (= flag 1) key_list)
      (setq key_list (subst (cons rec_key table ) old_rec key_list))
      (setq old_rec nil) );;cond
);;COND

;;format string ready for key re-assignment
(setq string (strcat string rec_key ";'"  table "'p"))
;;perform key redefinition
(prompt string)

;;reload list that was un-init before redefinition was run
(mmlll)
;;exit program quietly
(princ)

);;defun main

;;****************************************************
;;write key_list to hard disk. User is prompted for file name, but no error
;;checking is performed. The first line written to the file is an
;;identification string to be checked. This string is checked when the file is
;;loaded from the hard disk. The original key code and the macro string is
;;written to the file.
(defun c:mmw ( / f string x )
(terpri)
;;get file name, there is no error detection
(setq string (getstring "Enter list file to write: "))
(setq f (open string "w"))
(write-line "MM  Macro file " f)
(if f
  (progn                        ;;loop through key_list writing data
     (foreach x key_list        ;;to file
       (progn
         (write-line (car x) f)
         (write-line (cdr x) f)
       );;progn
    );;foreach
    (close f)
  );;progn
  ;;if error occurs opening file
  (*error* (strcat "Cant open file: " string))
);;if
(princ)
);;defun

;;*****************************************************************
;;these short programs allow users access to subroutines used by MM
;;disable macros list from command line
(defun c:mmul()(mmu)(terpri)(princ "Macros unloaded")(princ))
;;reload macro list from command line
(defun c:mmll()(mmlll)(terpri)(princ "Macros reloaded")(princ))

;;******************************************************************
;;load list from hard disk. If file does not exist then MMLF will abort
;;with an error message. If the file does not have the identification string
;;then the program assumes that the file is not a valid macro file and will
;;abort. The identification string is inserted when the file was written.
(defun c:mmlf( / x1 x2 string f)
(terpri)
(setq key_list nil)                                     ;;clear key_list
(setq string (getstring "Enter list file to load: "))   ;;get file name
(setq f (open string "r"))                              ;;open file
(if f
  (progn
    (if (= (read-line f) "MM  Macro file ")             ;;check if file is
      (progn                                            ;;valid macro file
        ;if file good                                   ;;if file is valid
        (while (setq x1 (read-line f))                  ;;then start reading
          (setq x2 (read-line f))                       ;;lines and building
            (if key_list                                ;;key lists
               ;;if key_list is empty then create it with first key list
               (setq key_list (append key_list (list (cons x1 x2))))
               ;;if key list is not empty, then add next key list
               (setq key_list (list (cons x1 x2)))
            );if
        );while
      );progn
      ;;if identification line did not match then abort
      (*error* (strcat string " is not a valid macro file"))
    );if is file valid macro file
    (close f)
  );progn
  ;;if file did not exist then abort
  (*error* (strcat string " is not a valid macro file"))
);if file exists

(mmlll)   ;;now that key_list has been built, macro redefinition
          ;;still must be performed to redefine keys
(princ)   ;;exit program quietly
)
;;*****************************************************
;;undo macro redefinitions and assign keys their correct value
(defun mmu( / x key )
(foreach x key_list
  (progn
    (setq key (car x))
    (prompt (strcat "\e[" key ";" key "p"))
  );;progn
)
)
;;*****************************************************
;;initialize macros from key_list
(defun mmlll( / x string)
(textscr)
(if key_list
  (foreach x key_list
    (progn
      (setq string (strcat "\e[" (car x) ";'" (cdr x) "'p")) ;;build string
      (prompt string)                                        ;;execute
    );;progn
  );;foreach
);;if
);;defun

;;******************************************************
;; regular get key function ****
;;returns character integer
(defun get_key( / code key )
(while (/= code 2)
   (setq code (grread))
   (setq key (car (cdr code)))
   (setq code (car code))
);;while
(eval key)
);;defun


(princ)
(terpri)
(princ  " Macro Maker Ver 1.00   Copyright (c) 1991 Scott Hares.  Invoke with MM")
(terpri)
(princ  " Please send $5.00 donation to Scott Hares 1108 Kelez Dr. San Jose Ca, 95120")
(terpri)
;;-------------------------------------------------------------------------
;;because the ansi driver is used to assign macros to keys, the macros must be
;;unloaded every time the drawing editor is left. The ansi driver runs at a
;;much lower level than the application running. This means that key
;;redefinitions will still be in effect until the system is rebooted or the
;;macros are explicitly un-defined. This can obviously interfere with other
;;applications the user might want to run. Macro unloading is done with the
;;key_list which is a global variable. This global variable however is lost
;;when the drawing editor is exited. Therefore the macros must be unloaded
;;every time the editor is exited. The following lines redefine the standard
;;Quit and End commands to include a function call to the MMUL function.
(setvar "CMDECHO" 0)
(command "undefine" "quit")
(command "undefine" "end")
(defun c:quit()(setvar "cmdecho" 0)(textscr)(mmu)(princ)(command ".quit"))
(defun c:end() (setvar "cmdecho" 0)(textscr)(mmu)(princ)(command ".end"))
(setvar "CMDECHO" 1)
(prin1)